home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / MacOberon / MacOberon (tools) / ErrorElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1991-02-15  |  6.7 KB  |  159 lines  |  [.Ob./.Ob2]
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. MODULE ErrorElems;    (** CAS 24-Jan-91 **)
  5.     IMPORT
  6.         Display, Input, Files, Fonts, Printer, Oberon, Texts, Viewers, MenuViewers,
  7.         WriteTexts, WriteFrames, WriteParcs;
  8.     CONST
  9.         ErrFile = "Errors.Text"; ErrFont = "Syntax8.Scn.Fnt";
  10.         mm = WriteTexts.mm;
  11.         CR = 0DX;
  12.         middleKey = 1; leftKey = 2;
  13.     TYPE
  14.         Elem* = POINTER TO ElemDesc;
  15.         ElemDesc* = RECORD(WriteTexts.ElemDesc)
  16.             err*: INTEGER;
  17.             msg*: ARRAY 128 OF CHAR
  18.         END;
  19.         DeleteMsg* = RECORD(Display.FrameMsg) END;
  20.         LocateMsg* = RECORD(Display.FrameMsg)
  21.             pos*: LONGINT
  22.         END;
  23.         font*: Fonts.Font;
  24.         W: Texts.Writer;
  25.         lastTime: LONGINT;
  26.     PROCEDURE MarkedFrame(): WriteFrames.Frame;
  27.         VAR V: Viewers.Viewer;
  28.     BEGIN V := Oberon.MarkedViewer();
  29.         IF (V IS MenuViewers.Viewer) & (V.dsc.next IS WriteFrames.Frame) THEN RETURN V.dsc.next(WriteFrames.Frame)
  30.         ELSE RETURN NIL
  31.         END
  32.     END MarkedFrame;
  33.     PROCEDURE Show(F: WriteFrames.Frame; pos: LONGINT);
  34.         VAR beg, end, delta: LONGINT;
  35.     BEGIN delta := 200;
  36.         LOOP WriteFrames.GetVisibleRange(F, beg, end);
  37.             IF (beg <= pos) & (pos < end) OR (beg = end) THEN EXIT END;
  38.             WriteFrames.Show(F, pos - delta); DEC(delta, 20)
  39.         END
  40.     END Show;
  41.     PROCEDURE Width(E: Elem): INTEGER;
  42.         VAR fnt: Fonts.Font; pat: Display.Pattern; i, px, dx, x, y, w, h: INTEGER;
  43.     BEGIN fnt := Fonts.This(ErrFont); i := 0; px := 0;
  44.         WHILE E.msg[i] # 0X DO
  45.             Display.GetChar(fnt.raster, E.msg[i], dx, x, y, w, h, pat); INC(px, dx); INC(i)
  46.         END;
  47.         RETURN px + 6
  48.     END Width;
  49.     PROCEDURE ShowErrMsg*(E: Elem; F: Display.Frame; col: SHORTINT; x0, y0, dw: INTEGER);
  50.         VAR fnt: Fonts.Font; pat: Display.Pattern; i, px, rm, dx, x, y, w, h: INTEGER; ch: CHAR;
  51.     BEGIN fnt := Fonts.This(ErrFont); i := 0; px := x0 + 3; rm := x0 + dw - 3; INC(y0, 2);
  52.         LOOP ch := E.msg[i]; INC(i);
  53.             IF ch = 0X THEN EXIT END;
  54.             Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
  55.             IF px + dx > rm THEN EXIT END;
  56.             Display.CopyPattern(col, pat, px + x, y0 + y, Display.invert); INC(px, dx)
  57.         END
  58.     END ShowErrMsg;
  59.     PROCEDURE Expand*(E: Elem; unit: LONGINT);
  60.         VAR S: Texts.Scanner; T: Texts.Text; n: INTEGER; ch: CHAR;
  61.     BEGIN NEW(T); Texts.Open(T, ErrFile); Texts.OpenScanner(S, T, 0);
  62.         REPEAT S.line := 0;
  63.             REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
  64.         UNTIL S.eot OR (S.class = Texts.Int) & (S.i = E.err);
  65.         IF ~S.eot THEN Texts.Read(S, ch); n := 0;
  66.             WHILE ~S.eot & (ch # CR) & (n + 1 < LEN(E.msg)) DO E.msg[n] := ch; INC(n); Texts.Read(S, ch) END;
  67.             E.msg[n] := 0X; E.W := Width(E) * unit; E.DX := E.W; WriteTexts.ChangedElem(E)
  68.         END
  69.     END Expand;
  70.     PROCEDURE Reduce*(E: Elem);
  71.     BEGIN E.W := 3 * mm; E.DX := E.W; E.msg[0] := 0X; WriteTexts.ChangedElem(E)
  72.     END Reduce;
  73.     PROCEDURE Delete*(E: Elem);
  74.         VAR T: WriteTexts.Text; pos: LONGINT;
  75.     BEGIN T := WriteTexts.ElemBase(E);
  76.         IF T # NIL THEN pos := WriteTexts.ElemPos(E); WriteTexts.Delete(T, pos, pos + 1) END
  77.     END Delete;
  78.     PROCEDURE Handle*(E: WriteTexts.Elem; VAR msg: Display.FrameMsg);
  79.         VAR e: Elem; pos: LONGINT; w, h: INTEGER; keys, keysum: SET;
  80.     BEGIN
  81.         WITH E: Elem DO
  82.             IF msg IS WriteTexts.DrawMsg THEN
  83.                 WITH msg: WriteTexts.DrawMsg DO w := SHORT(E.W DIV msg.unit); h := SHORT(E.H DIV msg.unit);
  84.                     Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 2, w - 2, h, Display.replace);
  85.                     IF E.msg[0] # 0X THEN ShowErrMsg(E, msg.frame, msg.col, msg.X0, msg.Y0 + 2, w) END
  86.                 END
  87.             ELSIF msg IS WriteTexts.PrintMsg THEN
  88.                 WITH msg: WriteTexts.PrintMsg DO w := SHORT(E.W DIV msg.unit); h := SHORT(E.H DIV msg.unit);
  89.                     Printer.ReplConst(msg.X0 + 1, msg.Y0 + 2, w - 2, h)
  90.                 END
  91.             ELSIF msg IS WriteTexts.CopyMsg THEN    (*copy element*)
  92.                 WITH msg: WriteTexts.CopyMsg DO
  93.                     IF msg.e = NIL THEN NEW(e); msg.e := e ELSE e := msg.e(Elem) END;
  94.                     e.err := E.err; e.msg := E.msg
  95.                 END
  96.             ELSIF msg IS WriteFrames.TrackMsg THEN    (*a mouse click hit the element*)
  97.                 WITH msg: WriteFrames.TrackMsg DO 
  98.                     IF msg.keys = {middleKey} THEN w := SHORT(E.W DIV msg.unit); h := SHORT(E.H DIV msg.unit);
  99.                         Oberon.RemoveMarks(msg.X0, msg.Y0, w, h);
  100.                         Display.ReplConst(15, msg.X0 + 2, msg.Y0 + 3, w - 4, h - 2, Display.invert);
  101.                         keysum := msg.keys;
  102.                         REPEAT Input.Mouse(keys, msg.X, msg.Y); keysum := keysum + keys;
  103.                             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y);
  104.                         UNTIL keys = {};
  105.                         Display.ReplConst(15, msg.X0 + 2, msg.Y0 + 3, w - 4, h - 2, Display.invert);
  106.                         IF keysum = {middleKey} THEN
  107.                             IF E.msg[0] = 0X THEN Expand(E, msg.unit) ELSE Reduce(E) END
  108.                         ELSIF keysum = {middleKey, leftKey} THEN Delete(E)
  109.                         END
  110.                     END
  111.                 END
  112.             ELSIF msg IS DeleteMsg THEN Delete(E)
  113.             ELSIF msg IS LocateMsg THEN
  114.                 WITH msg: LocateMsg DO pos := WriteTexts.ElemPos(E);
  115.                     IF pos < msg.pos THEN msg.pos := pos END
  116.                 END
  117.             END
  118.         END
  119.     END Handle;
  120.     PROCEDURE InsertAt*(T: WriteTexts.Text; pos: LONGINT; err: INTEGER);
  121.         VAR e: Elem;
  122.     BEGIN NEW(e); WriteTexts.OpenElem(e, Handle, 3 * mm, 3 * mm, 3 * mm);
  123.         e.temp := TRUE; e.err := err; e.msg[0] := 0X; WriteTexts.InsertElem(T, pos, e)
  124.     END InsertAt;
  125.     PROCEDURE Unmark*;
  126.         VAR F: WriteFrames.Frame; msg: DeleteMsg;
  127.     BEGIN F := MarkedFrame();
  128.         IF F # NIL THEN WriteTexts.Broadcast(F.text(WriteTexts.Text), 0, F.text.len, msg) END
  129.     END Unmark;
  130.     PROCEDURE Mark*;
  131.         VAR F: WriteFrames.Frame; S: Texts.Scanner; T: WriteTexts.Text;
  132.             text: Texts.Text; beg, end, time, pos, delta: LONGINT; err: INTEGER;
  133.     BEGIN Unmark; F := MarkedFrame(); Oberon.GetSelection(text, beg, end, time); delta := 0;
  134.         IF (F # NIL) & (time >= lastTime) THEN lastTime := time; T := F.text(WriteTexts.Text); Texts.OpenScanner(S, text, beg);
  135.             LOOP S.line := 0;
  136.                 REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
  137.                 IF S.eot OR (S.line # 0) THEN EXIT END;
  138.                 pos := S.i;
  139.                 REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
  140.                 IF S.eot OR (S.line # 0) THEN EXIT END;
  141.                 err := SHORT(S.i); InsertAt(T, pos + delta, err); INC(delta);
  142.                 REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
  143.             END
  144.         END
  145.     END Mark;
  146.     PROCEDURE LocateNext*;
  147.         VAR F: WriteFrames.Frame; msg: LocateMsg; beg: LONGINT;
  148.     BEGIN F := MarkedFrame();
  149.         IF F # NIL THEN msg.pos := MAX(LONGINT);
  150.             IF F.hasCar THEN beg := F.carLoc.pos ELSE beg := 0 END;
  151.             WriteTexts.Broadcast(F.text(WriteTexts.Text), beg, F.text.len, msg);
  152.             IF msg.pos < MAX(LONGINT) THEN Oberon.PassFocus(Viewers.This(F.X, F.Y));
  153.                 Show(F, msg.pos); WriteFrames.SetCaret(F, msg.pos + 1)
  154.             END
  155.         END
  156.     END LocateNext;
  157. BEGIN font := Fonts.This(ErrFont); Texts.OpenWriter(W); lastTime := -1
  158. END ErrorElems.
  159.